perm filename SCORA.F4[TMP,LCS] blob
sn#130163 filedate 1974-11-08 generic text, type T, neo UTF8
00100 C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
00200 C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
00300 C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
00400
00500
00600 C 7/74 ********** SCORE ********** LELAND SMITH, SEP.1969
00700
00800 C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND
00900 C GENERATION PROGRAM.
01000 C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
01100 C LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
01200 C SCANW, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
01300 C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
01400 C SUBROUTINE SUBR
01500 C COMMON /INS/ INST(27),BG(60)
01600 C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
01700 C INUM=INST# IPAR=PARAM#
01800 C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01900 C IF IREST IS <0, THAT NOTE WILL BE A REST.
02000 C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
02100 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
02200 C F1=86 F15=100 (NO F16!)
02300
02400 COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
02500 CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
02600 COMMON/A/ ROFF(27),V(2000),NP(27),PCH(27,32),
02671 1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
02742 1 ,P1(27),JFM(4),COPY(30),IFM(80)
02884 1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
02955 DIMENSION IV(2000),LIST(78),JNP(80)
03100 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
03200 C 40 LIT CHARS + 30 PARAMS PER INST.
03300 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
03400 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
03500 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
03600 1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
03620 COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,ITYP,INONLY,MX,
03640 1 Y,Z,ISLAC,MZ,LN,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
03660 1 ZZ,CHN,YY
03665 1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
03670 1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
03680 1 PARENS,JZ,BY,JED,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
03700 1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
03720 C /C/=26
03800 EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(IPP,ISCA(2))
03900 1 ,(IEN,ISCA(4)),(ISS,ISCA(9)),(ITT,ISCA(11))
04000 1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
04100 1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
04200 1 ,(V,IV),(LIST,IFM(3)),(JNP,INP)
04500 DATA KZY/27/,ISEMI/';'/,IQT/'"'/
04600 1, JFM(3)/','/
04700 C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
04800 DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
04900 1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
05000 1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
06500 LPAR=0
06600 IPRN=0
06700 QX=0.
06800 MOT=0
06900 RETRO=-1.
07000 INVRT=-1
07050 ICON=-1
07100 LCNT=1
07200 PARENS=0
07300 JZ=1
07400 CALL RNDINT
07500 C INIT RAND NUM GENERATOR.
07600 CC PR=0
07700 IAMP=0
07800 C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
07900 T5=0
08000 NINS=0
08100 K=0
08200 IDALL=-1
08300 QTS=-1.
08400 KB=0
08500 NWZ=1
08600 BNW(1)=0
08700 I=1
08800 KL=0
08900 TP=0
09000 KN=IBLA
09100 RA=0
09200 CHN=0
09300 DO 127 K=1,77,3
09400 127 LIST(K)=0
09500 C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
09600 NWX=0
09700 BY=-1
09800 DO 1128 K=1,KZY
09900 INVIS(K)=0
10000 INST(K)=0
10100 CNT(K)=0
10200 RDEV(K)=0
10300 C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
10400 NP(K)=0
10500 IQ(K)=0
10600 C IQ IS FOR RESTART FLAG
10700 IPT(K,1)=0
10800 DO 1128 L=1,32
10900 1128 PCH(K,L)=0
11000
11100 ITYP=-1
11200 C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
11300 C SECONDS TO BE OMITTED, DUR AT CUTOFF.
11400 JED=-1
11500 2112 TYPE 8002
11600 1112 ACCEPT 77732,INP
11700 JFM(4)='5F)'
11800 JFM(1)=' (A'
11900 C FOR FREE 'A' FORMAT
12000 CALL FMT(JFM,INP,MLX)
12100 REREAD JFM,K,TF,AMPFAC,OP1,DURX
12200 C JFM IS THE CURRENT FORMAT STATEMENT
12300 IF(K.NE.'EDIT')GO TO 3112
12400 JED=0
12500 GO TO 2112
12600 C 'E(DIT)' GOES TO EDIT MODE
12700 3112 IF(TF.EQ.0)TF=1.
12800 IF(AMPFAC.EQ.0)AMPFAC=1.
12900 21122 IF(K.NE.'TYPE')GO TO 128
13000 ITYP=0
13100 DATA FINM/30H(' TYPE OUTPUT FILE NAME'/) /
13150 IFLNM='FOR21'
13200 CC*** 7/74 COLGATE TYPE FINM
13300 C TO USE TYPE-IN MODE. FILE OF INPUT IS WRITTEN ON FOR21.DAT
13400 CC** 7/74 COLGATE ACCEPT 1127,ISLAC
13500 CC*** 7/74 COLGATE IF(ISLAC.EQ.IBLA)STOP
13600 REWIND 21
13700 CC** 7/74 COLGATE WRITE (21,1127) ISLAC
13800 GO TO 3127
13900 11122 FORMAT(1XA5,72A1)
14000 128 IF(K.NE.'INFO')GO TO 3128
14100 TYPE 8002
14200 TYPE 1113
14300 TYPE 118
14400 TYPE 1114
14500 TYPE 8002
14600 GO TO 1112
14700 118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
14800 CC*** TEMPORARY ***8002 FORMAT(' TYPE FILE NAME'/)
14810 8002 FORMAT(' **** NEW VERSION ****',//' TYPE FILE NAME-- '$)
14900 8001 FORMAT(A5,5F)
15000 107 FORMAT(I,A5,5F)
15100 1113 FORMAT(' NAME, TF, AMPFAC, OMIT", DUR".'/)
15200 1114 FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
15300 1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
15400 1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
15500 1127 FORMAT(A5,72A1)
15600 3128 IF(K.NE.IBLA)IFLNM=K
15700 CALL IFILE(1,IFLNM)
15790 CC*** 7/74 COLGATE READ(1,107)LN,ISLAC
15800 READ(1,107)LN,IXIN
15802 C CHECK FOR LINE NUMBERS ONLY.
15805 REWIND 1
15810 CALL IFILE(1,IFLNM)
15900 CC*** 7/74 REREAD 77732,JNP
16000 C FOR LATER USE
16100 CC** 7/74 IF(LN.NE.0)GO TO 3127
16200 C JUMP IF THE FILE HAS LINE NUMBERS.
16300 CC*** 7/74 REREAD 1127,ISLAC
16400 C REREADS FIRST LINE
16500
16610 3127 ISLAC=(IFLNM.AND."003777777777).OR."550000000000
16655 C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
16660 5127 TYPE 118
16700 IF(DURX.EQ.0)DURX=19999.
16800 IXIN=1
16900 CC -- NOW AT TOP OF PAGE 4(2/74) DO 1107 K=1,30
17000 CC1107 PL(K)=1.
17100 INONLY=-1
17200 ACCEPT 300,MX,X,Y,Z
17210 IF(MX.NE.99)GO TO 6127
17220 TYPE FINM
17230 ACCEPT 1127,ISLAC
17240 GO TO 5127
17300 6127 IF(Z.NE.0)INONLY=Z
17400 IF(X.NE.0)IXIN=X
17500 C MX=3 GIVES DURS ONLY
17600 C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
17700 C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
17800 MZ=0
17900 JOUT=5
18000 C 5=OUTPUT TO TTY
18100 SOS=-1.
18200 IF(Y.NE.0)SOS=0
18300 C IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
18400 IF(MX.NE.22)GO TO 2107
18500 JOUT=3
18600 C DIRECT TO LPT AT COLGATE 6/74
18700 CC JOUT=22
18800 CC REWIND 22
18900 2107 IF(MX.LE.1)MX=MX-2
19000 IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
19100 IF(MX.EQ.4)MZ=-4
19200 CC IF(SOS.AND.ITYP)WRITE(JOUT,87732)INP
19300 CC*** 7/74 COLGATE IF(SOS.AND.ITYP)CALL COLTTY(JNP,JOUT,3)
19400
19500 C *************** READS INPUT ***********************
19600 2308 IF(ITYP)GO TO 2127
19700 DATA TINST /25H(' TYPE INST NAME, ETC'/)/
19800 1,TEDIT/20H(' RETYPE LINE?'/ )/
19900 23081 TYPE TINST
20000 ACCEPT 77732,JNP
20100 CC IF(JED)WRITE(21,77732)INP
20200 IF(JED)CALL COLTTY(JNP,21,5)
20300 JFM(4)='72A1)'
20400 C PUTS ON LPT AND TTY
20500 GO TO 1074
20600 CC 6/74 COLGATE2127 JREAD=1
20700 CC 6/74 COLGATE 4400 READ(1,77732,END=2337)JNP
20800 2127 IF(READER(JNP))CALL RUNIT
20900 C READS A LINE. IF END OF FILE, JUMPS.
21000 CC SEE END OF PG.6 IF(SOS)WRITE(JOUT,87732)INP
21100 CC 7/74 IF(SOS)CALL COLTTY(JNP,JOUT,3)
21200 CC 6/74 COLGATE GO TO(441,442,443,444,445,446)JREAD
21300
21400 441 JFM(4)='72A1)'
21500 IF(LN.EQ.0)GO TO 1074
21600 REREAD 2114,LN,INP
21650 C**** READS ONLY FILES WITH LINE NUMBERS!
21700 JFM(1)=' (I,A'
21800 CALL FMT(JFM,INP,MLX)
21900 REREAD JFM,LN,J,INP
22000 GO TO 4127
22100 1074 JFM(1)=' (A'
22200 CALL FMT(JFM,INP,MLX)
22300 REREAD JFM,J,INP
22400 4127 IF(JED.OR.K.EQ.'Y')GO TO 41271
22500 C K CHECK IS TO PASS AFTER RETYPING
22600 TYPE TEDIT
22700 ACCEPT 77732,K
22800 IF(K.EQ.'Y')GO TO 23081
22900 IF(K.EQ.'G')JED=-1
23000
23100
23200 41271 IF(J.EQ.IBLA)GO TO 2308
23300 MLX=1
23400 IZ=0
23500 JA=-1
23600 ISUB=4
23650 CALL CLEAN(INP,LEND)
23675 C CLEANS OUT = AND , AND FINDS LINE LENGTH.
23700 ALL=1.
23800 VX1=0
23900 VX2=0
24000 VX3=0
24100 LK=-1
24200 K=0
24300 IF(V(I-1).NE.-9900.-BY)GO TO 364
24400 BY=-1.
24500 I=I-1
24600 364 DO 361 JD=1,LEND
24700 N=INP(JD)
24800 IF(N.NE.'R')GO TO 361
24900 C LOOKS FOR 'RESTART'
25000 DO 3611 M=JD,LEND
25100 KL=INP(M)
25200 IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI)GO TO 3631
25210 CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
25300 3611 INP(M)=IBLA
25400 C CHANGES 'RESTART' TO BLANKS
25500 3631 DO 363 N=1,NINS
25600 IF(J.NE.INST(N))GO TO 363
25700 IQ(N)=-1
25800 C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
25900 GO TO 362
26000 363 CONTINUE
26100 361 IF(N.EQ.ISEMI)GO TO 6773
26200 6773 K=K+1
26300 IF(K.GT.NINS)GO TO 36
26400 IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
26500 C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
26600 LK=K
26700 GO TO 1773
26800 36 IF(J.EQ.'RUN;'.OR.J.EQ.'RUN')CALL RUNIT
26900 IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6
27000 IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
27100 1GO TO 1773
27200 IF(J.EQ.'SECTI')GO TO 1081
27300 C****************** ABOVE AND BELOW FOR 'SECTIONS'
27400 IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
27500 362 LK=NINS+1
27600 IF(LK.GT.KZY)GO TO 99
27700 INST(LK)=J
27800 IZ=LK
27900 GO TO 1773
28000
28100 C*********** DOWN TO 99 FOR 'SECTIONS'
28200 1083 V(I)=-99.
28300 KL=1
28400 GO TO 3083
28500 C READS 'PLAY SECT. N1,N2'
28600 1081 V(I)=-199.
28700 KL=4
28800 3083 DO 2081 K=KL,72
28900 IF(INP(K).EQ.IBLA)GO TO 2081
29000 IV(I+1)=INP(K)
29100 I=I+2
29200 3081 BY=-1.
29300 GO TO 2308
29400 2081 CONTINUE
29500 C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
29600 C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
29700 C********* FEB 15,71
29800 1082 V(I)=-299.
29900 I=I+1
30000 GO TO 3081
30100 C MARKS END OF SECTION
30200 C************************
30300
30400 99 TYPE 199,LN
30500 STOP
30600 199 FORMAT(' ERROR!! LAST LINE READ =',I6/)
30700 4 IF(LK.LE.NINS)GO TO 8773
30800 IF(ALL.GT.0)GO TO 1004
30900 IF(IDALL.GT.0)GO TO 8773
31000 BG(LK)=VX1
31100 IDALL=LK
31200 GO TO 2004
31300 C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
31400 1004 BG(LK)=VX1
31500 IF(LK.EQ.IZ)VX1=0
31600 C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
31700 C CHECK EFFECT ON 'MOVE'!
31800 C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
31900 2004 NINS=LK
32000 IF(VX3.NE.0)VX2=10000.+VX3
32100 IF(VX2.EQ.0)VX2=-1
32200 DUR(LK)=VX2
32300 GO TO 900
32400 C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
32500 8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
32600 900 IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
32700 C*********** 'PLAY' IS FOR 'SECTIONS'
32800 BY=VX1
32900 C BY=CURRENT BG TIME.
33000 V(I)=-9900.-BY
33100 I=I+1
33200 IF(NWZ.NE.0)CALL BGSORT(BY)
33300 5773 IF(J.EQ.'TEMPO')GO TO 1106
33400 IF(J.EQ.'CONDU')GO TO 3018
33500 IF(J.EQ.'PLAY')GO TO 1083
33600 C*********** ABOVE FOR 'SECTIONS'
33650
33675
33700 4773 NW=LPAR
33800 IF(I.GT.1900.)TYPE 107,I
33900 ALL=1.
34000 DF=0
34100 ISUB=1
34200 CCZZZ1299 IF(JZ.NE.0)GO TO 1773
34250 1299 IF(JZ.NE.0)GO TO 2773
34300
34400
34500 7773 IF(ITYP)GO TO 77731
34600 DATA TPALN /20H(' TYPE A LINE'/) /
34700 77734 TYPE TPALN
34800 ACCEPT 77732,JNP
34900 CC IF(JED)WRITE(21,77732) INP
35000 IF(JED)CALL COLTTY(JNP,21,5)
35100 IF(INP1.EQ.IBLA)GO TO 77734
35200 GO TO 77733
35300 77732 FORMAT(80A1)
35400 CC87732 FORMAT(1X80A1)
35500 CC 6/74 COLGATE 77731 JREAD=2
35600 CC 6/74 COLGATE GO TO 4400
35700 77731 IF(READER(JNP))CALL RUNIT
35800 C READS A LINE. IF END OF FILE, JUMPS.
35900 442 IF(LN.NE.0)REREAD 2114,LN,INP
36000 IF(INP1.EQ.IBLA)GO TO 77731
36100 IF(JED)GO TO 77733
36200 TYPE TEDIT
36300 ACCEPT 77732,K
36400 IF(K.EQ.'Y')GO TO 77734
36500 IF(K.EQ.'G')JED=-1
36600 C DOESN'T WORK FOR EDITS AND INSERTS YET???
36700
36800
36900 77733 IF(ICON)MLX=1
36950 ICON=-1
36975 C FOR CONTINUATION LINES.
37000 C 'LISTS' MUST END WITH ; IN NEW(7/74) VERSION.
37010 2773 CALL CLEAN(INP,LEND)
37100 1773 IF(IPRN.EQ.0)GO TO 17732
37200 L=I-1
37300 IF(QTS.AND.V(I-1).EQ.999.)L=L-1
37400 IPRN=IPRN-1
37500 IF(PARENS.EQ.0)GO TO 17733
37600 PARENS=0
37700 LIST(LCNT+2)=L
37800 LCNT=LCNT+3
37900 IF(IPRN.EQ.0)GO TO 17732
38000 IPRN=0
38100 17733 LIST(MOT)=L
38200 MOT=0
38300 C FOR ERROR TRAP
38400
38500 17732 JZ=0
38600 N=0
38700 17731 ML=MLX
38800
38900 C BIG LOOP -- TO END OF PAGE 1.
39000 JD=ML
39100 975 N=INP(JD)
39200 IF(N.EQ.IBLA)GO TO 236
39210 CCZZZ IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
39300 C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
39400 33611 IF(N.NE.'('.AND.N.NE.')')GO TO 2361
39500 INP(JD)=IBLA
39600 L=JD-1
39700 5113 IF(INP(L).NE.IBLA)GO TO 2113
39800 L=L-1
39900 GO TO 5113
40000 2113 IF(N.EQ.')')GO TO 3361
40100 IF(PARENS.EQ.0)GO TO 1140
40200 LCNT=LCNT+3
40300 IF(MOT.NE.0)GO TO 11403
40400 MOT=LCNT-1
40500 1140 DO 11401 JC=1,LCNT-1,3
40600 IF(INP(L).NE.LIST(JC))GO TO 11401
40700 C FINDS DUPLICATE IDENTIFIER
40800 TYPE 11402,INP(L)
40900 GO TO 99
41000 11403 TYPE 11404
41100 GO TO 99
41200 11404 FORMAT(' MORE THAN 2 PARENS OPEN'/)
41300
41400 11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
41500 11401 CONTINUE
41600 LIST(LCNT)=INP(L)
41700 PARENS=-1.
41800 INP(L)=IBLA
41900 LIST(LCNT+1)=I
42000 GO TO 236
42100 C ''''''' FOR SINGLE QUOTES
42200 3361 IPRN=IPRN+1
42300 GO TO 236
42400 C JUMPS BACK INTO QUOTE SECTION
42500 CQ IF(PARENS.EQ.0)GO TO 2140
42600 CQ LIST(LCNT+2)=L
42700 CQ LCNT=LCNT+3
42800 CQ PARENS=0
42900 CQ GO TO 33612
43000 CQ2140 LIST(MOT)=L
43100 CQ GO TO 33612
43200 CQC ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
43300 C @@@@@@@@@@@@ /@Z/DS3/ ETC.
43400 2361 IF(N.NE.'@')GO TO 5361
43500 DO 113 L=1,LEND
43600 K=JD+L
43700 C K IS USED AT 240!!!
43800 JG=INP(K)
43900 IF(JG.NE.'-')GO TO 6113
44000 RETRO=0
44100 INP(K)=IBLA
44200 GO TO 113
44300 6113 IF(JG.NE.'$')GO TO 7113
44400 C '$' IS FOR INVERSIONS IN 'NOTES'
44500 INVRT=0
44600 GO TO 113
44700 7113 IF(JG.NE.IBLA)GO TO 4113
44800 113 CONTINUE
44900 4113 DO 6361 L=1,LCNT,3
45000 IF(JG.NE.LIST(L))GO TO 6361
45100 VX1=0
45200 DO 40 M=JD+2,LEND
45300 JG=INP(M)
45400 IF(JG.EQ.IBLA)GO TO 40
45500 CCZZZ IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
45510 IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI)GO TO 140
45600 ML=M
45700 GO TO 240
45800 40 CONTINUE
45900 240 JC=JA
46000 JA=-1
46100 INP(K)=IBLA
46200 CALL SCANR
46300 JA=JC
46400 140 JC=1
46500 KN=LIST(L+1)
46600 M=LIST(L+2)+1
46700 IF(RETRO)GO TO 640
46800 JC=M-1
46900 M=KN-1
47000 KN=JC
47100 JC=-1
47200 RETRO=-1.
47300 640 IF(INVRT)GO TO 940
47400 840 X=V(KN)
47500 V(I)=X+VX1
47600 C FINDS CENTER FOR INVERSION (+TRANSP.)
47700 I=I+1
47800 KN=KN+JC
47900 IF(V(KN-JC).NE.85.)GO TO 940
48000 V(I-1)=85.
48100 GO TO 840
48200
48300 940 Z=V(KN)
48400 IF(INVRT.EQ.0)GO TO 440
48500 IF(VX1.EQ.0)GO TO 540
48600 C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
48700 IF(CODE.EQ.-33.)GO TO 440
48800 V(I)=Z*VX1
48900 GO TO 7361
49000 440 IF(Z.EQ.85.)GO TO 540
49100 Y=0
49200 IF(INVRT.EQ.0)Y=(X-Z)*2.
49300 V(I)=Z+VX1+Y
49400 GO TO 7361
49500 540 V(I)=Z
49600 7361 I=I+1
49700 KN=KN+JC
49800 IF(KN.NE.M)GO TO 940
49900
50000 INVRT=-1
50100 RB=V(I-1)
50200 DO 8361 L=JD,LEND
50300 JG=INP(L)
50400 C PUT IN NOV 25, 72
50500 CCZZZ IF(JG.EQ.ISEMI)GO TO 93612
50550 KN=L
50600 INP(L)=IBLA
50700 IF(JG.EQ.KSLA)GO TO 9361
50800 IF(JG.EQ.')')IPRN=IPRN+1
50900 CCZZZ8361 IF(JG.EQ.'*')IAMP=-1
50950 8361 IF(JG.EQ.ISEMI)IAMP=-1
50975 GO TO 93612
51000 9361 MLX=L
51100 C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
51200 IF(IAMP.EQ.0.AND.QTS)GO TO 1773
51210 C GO BACK IF NOT END OF LINE
51300 JZ=-1
51400 93612 IF(IAMP.EQ.0)GO TO 93611
51500 C NOV 25, 72
51600 IF(QTS)GO TO 3013
51700 GO TO 2722
51800 C THESE ARE FOR "LIT" ITEMS
51900 C ******* DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
52000 C NO $ WITH FUNC. $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
52100 CCZZZ93611 IF(JG.EQ.ISEMI)GO TO 7773
52150 93611 IF(KN.EQ.LEND)GO TO 7773
52200 JZ=0
52300 IF(IPRN.NE.0)GO TO 1773
52400 C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
52500 GO TO 236
52600 C LAST TIME FOR QUOTES
52700
52800 C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
52900 C JUMPS TO END STRING OF QUOTES
53000 6361 CONTINUE
53100 GO TO 99
53200 C @@@@@@@@@@@@@@@@@@@@@@@@@@
53300 5361 IF(N.EQ.'$')GO TO 99
53400 C FOUND $ BUT NO @!
53500 IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
53600 IF(INP(JD+1).NE.IF)GO TO 236
53700 C JUMP IF NOT DUTY FACTOR
53800 DF=DF-100.
53900 GO TO 43615
54000 53611 IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
54100 DF=DF-200
54200 C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
54300 GO TO 43615
54400 53612 IF(N.NE.IAA)GO TO 43611
54500 C FINDS 'ALL'.
54600 IF(INP(JD+1).NE.'L')GO TO 236
54700 ALL=-1.
54800 GO TO 43615
54900 C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
55000
55100 C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
55200 C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
55300 C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
55400 C BEFORE! QUAD (IF USED).
55500 C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
55600 C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
55700 C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
55800 43611 IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
55900 QX=-13.
56000 DO 43612 N=JD,LEND
56100 J=INP(N)
56200 IF(J.EQ.IXX)QX=QX-1.
56300 IF(J.EQ.IF)QX=QX-2.
56400 IF(J.EQ.IBLA.OR.J.EQ.KSLA)GO TO 236
56410 CCZZZ IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
56500 43612 INP(N)=IBLA
56600 4361 IF(N.NE.'I')GO TO 43613
56700 IF(ISUB.NE.4)GO TO 43613
56800 C NEXT MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
56900 INVIS(LK)=-1
57000 43615 DO 43614 L=JD,LEND
57100 N=INP(L)
57200 IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
57210 CCZZZ IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
57300 43614 INP(L)=IBLA
57400 43613 IF(N.NE.KSLA)GO TO 636
57500 MLX=JD+1
57600 JZ=-1
57650 IF(JD.GE.LEND-1)JZ=0
57675 C SO IT WILL READ NEXT LINE.
57700 INP(JD)=ISEMI
57710 GO TO 336
57800 CCZZZ436 IF(INP(MLX).NE.IBLA)GO TO 336
57900 CCZZZ MLX=MLX+1
58000 CCZZZ GO TO 436
58100 636 IF(JD.LT.LEND)GO TO 1336
58102 ICON=0
58105 GO TO 77731
58107 C TO CONTINUE ON NEXT LINE.
58110 CCZZZ636 IF(N.NE.ISEMI)GO TO 936
58120 1336 IF(N.NE.ISEMI)GO TO 936
58135 IF(ISUB.NE.1)IAMP=-1
58200 336 IF(ISUB.EQ.104)GO TO 104
58300 IF(ISUB.GT.3)GO TO 1899
58400 GO TO (101,102,103),ISUB
58500 C PAR MOV LIST OTHERS
58600 CCZZZ936 IF(N.NE.IDOT)GO TO 736
58610 936 IF(N.NE.IDOT)GO TO 136
58700 L=INP(JD+1)
58800 DO 836 KL=1,10
58900 836 IF(L.EQ.IDAT(KL))GO TO 236
59000 IF(CODE.EQ.-22.)INP(JD)=1
59100 GO TO 236
59200 C CHANGES DOTTED RHYTHMS TO '1'S.
59310 CCZZZ736 IF(N.NE.'*')GO TO 136
59400 CCZZZ IAMP=-1
59510 CCZZZ INP(JD)=IBLA
59600 CCZZZ GO TO 336
59700 136 IF(N.NE.IQT)GO TO 236
59800 DO 1361 K=JD+1,LEND
59900 IF(INP(K).NE.IQT)GO TO 1361
60000 JD=K+1
60100 GO TO 975
60200 C SKIPS MATERIAL IN QUOTES
60300 1361 CONTINUE
60400 GO TO 99
60500 C OPEN QUOTES
60600 236 JD=JD+1
60700 IF(JD.LE.LEND)GO TO 975
60800 TYPE 1236
60900 GO TO 99
61000 1236 FORMAT(' NO END MARK')
62000 1899 CALL SCANR
62100 GO TO(1,2,3,4,5,6),ISUB
00100 101 N=INP(ML)
00200 IZ=ML
00300 ML=ML+1
00400 IF(N.EQ.IBLA)GO TO 101
00500 C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600 JA=-1
00700 IF(N.EQ.IPP)GO TO 1
00800 IF(N.EQ.IE)GO TO 2308
00900 IF(N.EQ.'R')CALL RUNIT
01000 C 'RUN' MAY REPLACE 'END' FOR LAST INST.
01100 IF(N.EQ.ID)GO TO 7720
01200 GO TO 99
01300 1 CALL SCANR
01400 LPAR=VX1
01500 IJ=LPAR
01600 IF(QX.GE.0)GO TO 5703
01700 IJ=LPAR+4
01800 C SETS UP PARAM FOR QUAD CALL
01900 V(I)=IJ+LK*10000
02000 V(I+1)=2*ALL
02100 C TEST "ALL" FEATURE HERE!!!!!!!
02200 C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300 V(I+2)=QX
02400 I=I+3
02500 QX=0.
02600 5703 IAMP=0
02700 IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
02800 IF(LPAR.EQ.32)LPAR=1
02900 V(I)=LPAR+LK*10000
03000 C +1=WDCNT, +2=CODE, +3='NM' CCCCC
03100 IJ=I+1
03200 I=I+4
03300 ITMP=0
03400 CODE=0
03500 NFLG=1
03600 ML=IZ+M
03700 C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
03800 C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
03900 C QU=QUADC QUX=QUADX
04000 5702 ML=ML+1
04100 IF(ML.GT.72)GO TO 99
04200 N=INP(ML)
04300 IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 5702
04400 NL=INP(ML+1)
04500 JA=-1
04600 ISUB=0
04700 IF(N.EQ.IXX)GO TO 2703
04800 IF(N.EQ.'R')GO TO 6702
04900 IF(N.EQ.IF)GO TO 8702
05000 4005 JA=0
05100 IF(N.EQ.IEN)GO TO 6005
05200 IF(N.EQ.'M')GO TO 703
05300 IF(N.EQ.'L')GO TO 2720
05400 IF(N.EQ.ISS)GO TO 6703
05500 IF(N.EQ.ITT)GO TO 4018
05600 IF(N.EQ.IQT)GO TO 5720
05700 IF(N.EQ.ISEMI)GO TO 2018
05800 IF(N.EQ.IPP)JA=-1
05900 C FOR /P5 P3/
06000 CALL SCANR
06100 IF(ISUB.EQ.8)GO TO 8
06200 I=I+JJ
06300 V(IJ+1)=NNUM+DF
06400 IF(JJ.EQ.1)GO TO 4006
06500 C IF NNUM IS '-2' THEN NOTES ARE PRINTED
06600 IF(NNUM.NE.-2)GO TO 5006
06700 IX=IJ+3
06800 DO 2006 K=2,JJ,3
06900 2006 CALL RANR(VX,K)
07000 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
07100 5006 IX=IJ+2
07200 DO 6006 K=1,JJ
07300 6006 V(IX+K)=VX(K)
07400 V(IX+JJ-2)=1.
07500 C ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
07600 GO TO 3013
07700 4006 IF(JA)VX1=VX1/100.+9999.
07800 C CHANGES /P5 P3/ TO /P5 9999.03/ ***** CHECK OUT ON OTHER MACHINES!
07900 V(I-1)=VX1
08000 GO TO 3013
08100 6702 IF(NL.EQ.IE)GO TO 2703
08200 C JUMP IF "REP"
08300 IF(NL.EQ.ITT)GO TO 4018
08400 C JUMP IF "RTAP"
08500 CODE=-22
08600 IF(NL.EQ.'L')CODE=-46.0
08700 C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
08800 IF(NL.NE.IEN)GO TO 1016
08900 C JUMP IF NOT "RNOTES"
09000 JA=0
09100 C FOR SCANR
09200 CODE=-36.
09300 GO TO 1016
09400 6005 CODE=-33
09500 IF(NL.NE.'U')GO TO 1016
09600 CODE=-44.
09700 1610 JA=-1
09800 GO TO 1016
09900 8702 CODE=-35
10000 IF(NL.EQ.'U')GO TO 1016
10100 ML=ML+1
10200 CALL SCANR
10300 7 V(IJ+1)=CODE+DF
10400 V(IJ+2)=1.
10450 IF(VX1.GT.15)GO TO 99
10475 C TRAPS F NUMS >15.
10500 V(I)=VX1+85.
10600 GO TO 7703
10700 C******** MOVE IS NEXT ***********
10800 703 BW=V(IJ-2)
10900 IC=0
11000 DO 7031 K=ML+1,72
11100 IF(INP(K).EQ.ISEMI)GO TO 8031
11200 7031 IF(INP(K).EQ.IXX)IC=-1
11300 C IC=-1 IS FOR MOVX
11400 8031 I=I-1
11500 V(I)=0
11600 X=-9900.-BY
11700 IF(BY.EQ.0)X=-9900.-BG(LK)
11800 IF(BW.EQ.X)GO TO 8005
11900 IF(BW.NE.-9900.-BY)GO TO 1102
12000 V(IJ-2)=X
12100 GO TO 8005
12200 1102 V(IJ)=V(IJ-1)
12300 V(IJ-1)=X
12400 IJ=IJ+1
12500 I=I+1
12600 8005 LP=IJ-1
12700 BW=-9900.-X
12800 ISUB=2
12900 IZ=-1
13000 C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13100 4703 GO TO 1299
13200 102 IF(IZ.LT.0)GO TO 2102
13300 C SKIPS NEXT FIRST TIME
13400 BW=V(ICT)+BW
13500 V(I)=-9900.-BW
13600 V(I+1)=V(LP)
13700 V(I+2)=(JJ+2)*ALL
13800 V(I+3)=CODE+DF
13900 I=I+4
14000 IZ=1
14100 2102 IF(BW.LT.10000.)CALL BGSORT(BW)
14200 C ROUND-OFF NONSENSE
14300 2 VX3=-9900.
14400 VX2=VX3
14500 CALL SCANR
14600 IF(JJ.GT.0)GO TO 5102
14700 JJ=ILIT
14800 C SLASH WILL REPEAT MOVE INPUT -- 6/74
14900 DO 6102 K=1,JJ
15000 6102 VX(K)=VX(K+20)
15100 GO TO 5005
15200 C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
15300 5102 IF(JJ.EQ.4)GO TO 99
15400 C ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
15500 IF(VX3.NE.-9900.)GO TO 3102
15600 IF(VX2.NE.-9900.)GO TO 4102
15700 VX2=VX1
15800 VX1=10000.
15900 4102 VX3=VX2
16000 JJ=3
16100 C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
16200 3102 IF(IZ.GE.0)GO TO 3006
16300 V(IJ)=(JJ+2)*ALL
16400 C WORD COUNT
16500 CODE=-55.
16600 IF(JJ.NE.3)CODE=-57.
16700 IF(NFLG)CODE=CODE-1.
16800 IF(IC)CODE=-59.
16900 C CODE=-56 OR -58 FOR NOTES.
17000 V(IJ+1)=CODE+DF
17100 IZ=0
17200 3006 IF(NFLG.EQ.1)GO TO 5005
17300 CALL RANR(VX,2)
17400 IF(JJ.NE.3)CALL RANR(VX,4)
17500 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
17600 5005 ICT=I
17700 ILIT=JJ
17800 C SAVES FOR SLASH REPEAT FEATURE
17900 IJ=IJ+1
18000 DO 1006 K=1,JJ
18100 VX(20+K)=VX(K)
18200 C SAVES FOR SLASH REPEAT FEATURE
18300 1006 V(IJ+K)=VX(K)
18400 I=I+JJ
18500 IJ=I+2
18600 IF(IAMP.EQ.0)GO TO 1299
18700 C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
18800 V(I)=-9900.-BY
18900 GO TO 8703
19000
19100 7703 V(IJ)=4.*ALL
19200 8703 I=I+1
19300 GO TO 4773
19400 C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
19500 6703 CODE=-12.
19600 IF(INP(ML+3).EQ.'L')CODE=-11.
19700 V(IJ)=2.*ALL
19800 V(IJ+1)=CODE+DF
19900 I=I-1
20000 GO TO 4773
20100 4018 CNT(LK)=-9900.-BY
20200 P(LK)=V(I-4)
20300 CC 6/74 COLGATE JREAD=3
20400 CC 6/74 COLGATE GO TO 4400
20500 IF(READER(JNP))CALL RUNIT
20600 C READS A LINE. IF END OF FILE, JUMPS.
20700 443 IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
20800 IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
20900 C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
21000 IF(NL.NE.ITT)GO TO 2338
21100 CODE=-23.
21200 GO TO 1016
21300 2338 I=I-4
21400 GO TO 4773
21500 3018 CNT(KZY)=-9900.
21600 CC JREAD=4
21700 CC COLGATE 6/74 GO TO 4400
21800 IF(READER(JNP))CALL RUNIT
21900 C READS A LINE. IF END OF FILE, JUMPS.
22000 444 IF(LN.NE.0)REREAD 107,K,IPT(KZY,1)
22100 IF(LN.EQ.0)REREAD 8001,IPT(KZY,1)
22200 P(KZY)=980000.
22300 GO TO 2308
22400 C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22500 C 'REP'
22600 2703 ML=ML+1
22700 VX1=0
22800 VX2=0
22900 VX3=0
23000 IF(N.EQ.IXX)GO TO 2704
23100 INP(ML)=IBLA
23200 INP(ML+1)=IBLA
23300 C WIPES OUT 'EP' IN 'REP'
23400 2704 CALL SCANR
23500 V(IJ)=3.
23600 V(IJ+1)=-66.0
23700 IF(VX1.EQ.32.)VX1=1.
23800 IF(VX1.EQ.0)VX1=LPAR
23900 IF(VX2.EQ.0)VX2=LK-1
24000 V(IJ+2)=VX1+VX2*10000.
24100 KL=VX2
24200 IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24300 IF(VX3.EQ.0)GO TO 4773
24400 L=VX3
24500 ML=LK+1
24600 DO 1018 KL=ML,L
24700 IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
24800 IF(DUR(KL))DUR(KL)=DUR(LK)
24900 C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
25000 V(I)=V(I-4)+10000.
25100 V(I+1)=3.
25200 V(I+2)=-66.
25300 V(I+3)=V(I-1)
25400 1018 I=I+4
25500 GO TO 4773
25600
25700 2018 IF(DF.EQ.0)GO TO 20181
25800 C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
25900 V(IJ+1)=-201.
26000 V(IJ+2)=1.
26100 V(IJ+3)=0
26200 GO TO 7703
26300 20181 V(IJ)=3.
26400 V(IJ+1)=-66.
26500 V(IJ+2)=NW+LK*10000
26600 GO TO 4773
26700 C READS /P5 .3 "ABC" .7 "XYZ"/
26800
26900 8 V(IJ+1)=-77.+DF
27000 C DF HAS SUBR CALL INFO
27100 I=I+1
27200 VX(JJ-1)=1
27300 C FOR RAND. SINGLE LITS.
27400 DO 3722 K=1,JJ,2
27500 V(I)=VX(K)
27600 3722 I=I+1
27700 V(IJ+2)=JJ/2
27800 V(IJ+3)=I
27900 DO 4722 K=2,JJ,2
28000 KN=I
28100 I=I+1
28200 L=VX(K)
28300 DO 6722 KL=L,72
28400 IF(INP(KL).EQ.IQT)GO TO 4722
28500 IV(I)=INP(KL)
28600 6722 I=I+1
28700 4722 V(KN)=I-KN-1
28800 V(IJ)=(I-IJ)*ALL
28900 GO TO 4773
29000 2720 QTS=0
29100 ISUB=104
29200 GO TO 1299
29300
29400 104 DO 6721 K=ML,LEND
29500 JC=K+1
29600 IF(INP(K).EQ.IQT)GO TO 7721
29700 6721 IF(INP(K).EQ.KSLA.OR.INP(K).EQ.ISEMI)GO TO 7232
29800 C FOR REPEAT OF ITEM BY SLASH
29900 CC7232 DO 7231 K=I-1,1,-1
30000 CC CHNGD 6/74 IF(ABS(V(K)).GT.72.)GO TO 7231
30100 CC NL=V(K)
30200 CC DO 7230 KL=K,K+NL
30300 7232 DO 7230 KL=ILIT,ILIT+NLIT
30400 V(I)=V(KL)
30500 7230 I=I+1
30600 GO TO 27222
30700 7231 CONTINUE
30800
30900 5720 IAMP=-1
31000 JC=ML+1
31100 C FOR SINGLE 'LIT' ITEMS.
31200 7721 DO 1722 KL=JC+1,LEND
31300 IF(INP(KL).NE.IQT)GO TO 1722
31400 JD=KL-1
31500 ML=KL+1
31600 NLIT=KL-JC
31700 C EXTENT OF LIT ITEM IS FOUND
31800 GO TO 8721
31900 1722 CONTINUE
32000 C CAN'T USE SLASH FOR REPEAT AFTER @Q
32100 8721 V(I)=NLIT
32200 ILIT=I
32300 DO 9721 K=JC,JD
32400 C PUTS ITEM IN "IV" ARRAY
32500 I=I+1
32600 9721 IV(I)=INP(K)
32700 I=I+1
32800 27222 IF(IAMP.EQ.0)GO TO 1299
32900 2722 V(I)=999.
33000 QTS=-1.
33100 27221 V(IJ+1)=-88.+DF
33200 V(IJ)=(I-IJ+1)*ALL
33300 IJ=IJ+2
33400 V(IJ)=IJ+1
33500 I=I+1
33600 ISUB=1
33700 GO TO 1299
33800
33900 7720 V(I)=LK
34000 V(I+1)=3.
34100 V(I+2)=-67.
34200 ML=ML+4
34300 CALL SCANR
34400 V(I+3)=VX1
34500 I=I+4
34600 L=VX1
34700 IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
34800 IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
34900 GO TO 4773
35000 C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
35100 142 FORMAT(I,15A5)
35200 1301 FORMAT(15A5)
35300 CCC2773 FORMAT(I,A5,72A1)
35400 2114 FORMAT(I,72A1)
35500 300 FORMAT(I,3F,A1)
35600 301 FORMAT(3F,A1)
35700 6 KB=KB+1
35800 IF(JED.GT.0)JED=0
35900 IF(J.EQ.'INSER')GO TO 1340
36000 OTH(KB,1)=VX1*100000.+VX2*100.+VX3
36100 GO TO 340
36200 1340 X=VX1
36300 IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
36400 OTH(KB,1)=X
36500 GO TO 1338
36600 C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
36700 C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
36800 C - BEGIN LINE WITH <,END WITH ;
36900 C UP TO 75 CHARACTERS MAY BE TYPED.
37000 340 IF(VX3.NE.2)GO TO 1338
37100 IF(ITYP.GE.0)GO TO 449
37200 CC JREAD=5
37300 CC 6/74 COLGATE GO TO 4400
37400 IF(READER(JNP))CALL RUNIT
37500 C READS A LINE. IF END OF FILE, JUMPS.
37600 445 OTH(KB,3)=1.
37700 IF(LN.EQ.0)GO TO 447
37800 REREAD 300,K,OTH(KB,2)
37900 GO TO 1447
38000 447 REREAD 301,OTH(KB,2)
38100 1447 IF(JED)GO TO 2308
38200 3445 TYPE TEDIT
38300 ACCEPT 77732,K
38400 IF(K.EQ.'G')JED=-1
38500 IF(J.EQ.'INSER')GO TO 3446
38600 IF(K.NE.'Y'.OR.JED)GO TO 2308
38700 449 TYPE TPALN
38800 ACCEPT 301,OTH(KB,2)
38900 IF(JED)WRITE(21,301) OTH(KB,2)
39000 GO TO 2308
39100
39200 1338 IF(ITYP.GE.0)GO TO 1449
39300 CC JREAD=6
39400 CC 6/74 COLGATE GO TO 4400
39500 IF(READER(JNP))CALL RUNIT
39600 C READS A LINE. IF END OF FILE, JUMPS.
39700 446 IF(LN.EQ.0)GO TO 448
39800 REREAD 142,K,(OTH(KB,JD),JD=2,16)
39900 GO TO 1446
40000 448 REREAD 1301,(OTH(KB,JD),JD=2,16)
40100 1446 IF(JED)2446,3445,2446
40200 3446 IF(K.NE.'Y'.OR.JED)GO TO 2446
40300 1449 TYPE TPALN
40400 ACCEPT 1301,(OTH(KB,JD),JD=2,16)
40500 IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
40600 2446 X=OTH(KB,2)
40700 IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
40800 IF(X.EQ.'*')KB=KB-1
40900 C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
41000 C LAST LINE HAS '*' IN COLUMN 1.
41100 GO TO 2308
41200 C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
41300 C INSERT MAY INCLUDE 10 CHARS(P3-P30),
41400 C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
41500 C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
41600 C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
41700 C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
41800 C BX=INST N. Y=NOTE N. Z=PARAM N.
00100 1106 KTMP=1
00200 TP=60.
00300 IAMP=0
00400 BW=BY
00500 ITMP=-1
00600 ISUB=5
00700 JA=-1
00800 GO TO 2016
00900 3019 V(I)=990000.00
01000 V(I+1)=4.
01100 V(I+2)=VX1
01200 V(I+3)=VX2/TP
01300 V(I+4)=VX3/TP
01400 I=I+5
01500 BY=BW
01600 C SEPT 18, 70
01700 IF(VX1.EQ.0)GO TO 2308
01800 BW=BW+VX1
01900 V(I)=-9900.-BW
02000 I=I+1
02100 CALL BGSORT(BW)
02200 9003 IF(IAMP)GO TO 4003
02300 2016 VX3=0
02400 VX2=0
02500 GO TO 1299
02600 5 IF(VX2.NE.0)GO TO 105
02700 C 'TEMPO/120*;' OR 'TEMPO/1.5 72*;' IS OK.
02800 VX2=VX1
02900 VX1=0
03000 105 IF(VX3.EQ.0)VX3=VX2
03100 IF(VX2.LT.11.)TP=1.
03200 IF(J.EQ.ITMPO)GO TO 3019
03300 PCH(1,KTMP)=VX1
03400 PCH(2,KTMP)=VX2
03500 PCH(3,KTMP)=VX3
03600 C PCH(1)=TIME (2)=MM1 (3)=MM2
03700 KTMP=KTMP+1
03800 IF(IAMP.EQ.0)GO TO 2016
03900 4003 VX1=0
04000 IAMP=0
04100 VX2=VX3
04200 IF(J.EQ.ITMPO)GO TO 3019
04300 PCH(1,KTMP)=0
04400 PCH(2,KTMP)=VX2
04500 PCH(3,KTMP)=VX2
04600 C MM CAN BE FROM 11 UP ITMPO FACTOR FROM 10 DOWN.
04700 C UP TO 30 ITMPO CHANGES MAY BE MADE.
04800
04900 1016 IA=I
05000 IZ=1
05100 3100 V(I-2)=CODE+DF
05200 ISUB=3
05300 5016 IF(IAMP.GE.0)GO TO 1299
05400 117 IF(IZ-2)3013,9004,9004
05500 103 K=INP(ML)
05600 IF(K.EQ.ITT)GO TO 1106
05700 IF(K.EQ.ISEMI)GO TO 1014
05800 IF(K.NE.IBLA) GO TO 1899
05900 ML=ML+1
06000 GO TO 103
06100 3 IF(VX1.EQ.-99.)GO TO 4022
06200 IF(CODE.EQ.-22.)GO TO 2017
06300 IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
06400 C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06500 2017 IF(VX1.EQ.10000.)GO TO 17
06600 VX1=4./VX1
06700 IF(JJ.NE.1)GO TO 2014
06800 V(I)=VX1
06900 GO TO 114
07000
07100 1217 IF(VX1.EQ.10000.)GO TO 114
07200 C FOR "FINE" IN LIST
07300 V(I+1)=VX2
07400 IF(CODE.EQ.-36.)CALL RANR(V,I)
07500 2217 I=I+1
07600 C SETS UP STRING OF RAND SELECTIONS
07700 GO TO 114
07800 3217 V(I)=V(I-2)
07900 V(I+1)=RB
08000 C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
08100 GO TO 2217
08200 C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
08300
08400 2014 DO 9006 L=2,JJ
08500 IF(VX(L).EQ.0)GO TO 17
08600 9006 VX1=4./VX(L)+VX1
08700 JJ=1
08800 17 V(I)=VX1
08900 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
08950 IF(CODE.EQ.-35.AND.VX1.GT.15)GO TO 99
08975 C FINDS F NUM.>15!
09000 C JUMP IF STRING OF RAND SELECS.
09100 IF(JJ.EQ.1)GO TO 114
09200 L=VX(JJ)-1
09300 X=V(I)
09400 NL=I+1
09500 I=L+I
09600 DO 1017 K=NL,I
09700 1017 V(K)=X
09800 C ADDS UP TOTAL OF NOTES IN SEQ.
09900 IZ=IZ+L
10000 GO TO 114
10100 1014 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
10200 V(I)=RB
10300 C RB SAVES IT FOR SLASH REPEAT
10400 114 RB=V(I)
10500 I=I+1
10600 IZ=IZ+1
10700 GO TO 5016
10800 4022 JC=VX2+.3
10900 JD=VX3-.5
11000 IF(JJ.EQ.2)JD=1
11100 C********* MAY 19,71 ----MANY LINES ABOVE.
11200 IZ=IZ+JC*JD
11300 C JC=HOW MANY TIMES, JD=HOW MANY NOTES
11400 DO 1005 K=1,JD
11500 NL=I+JC-1
11600 DO 2005 L=I,NL
11700 2005 V(L)=V(L-JC)
11800 1005 I=I+JC
11900 RB=V(NL)
12000 C RB SAVES DATA FOR SLASH REPEAT FEATURE.
12100 GO TO 5016
12200
12300 9004 IF(ITMP.EQ.0)GO TO 3013
12400 C*********** JUNE 1,71
12500 IZ=IZ-1
12600 C***** JAN. 1974
12700 KA=1
12800 IC=1
12900 K=0
13000 J=1
13100 Z=0
13200 RC=0
13300 9007 Y=PCH(3,IC)/TP
13400 X=PCH(2,IC)/TP
13500 Z=PCH(1,IC)
13600 CALL SQYY(YY,X,Y,Z)
13700 XT(1)=X
13800 PR=RA
13900 RD=1
14000 RB=0
14100 ZZ=Z
14400 CALL ACCEL
18300 IF(K.NE.IZ.AND.RA.NE.10000.)GO TO 9007
18400 C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
18600 3013 X=I-IJ
18700 V(IJ+2)=X-3.
18800 V(IJ)=X*ALL
18900 IF(CODE.NE.-35)GO TO 4773
19000 M=IJ+3
19100 C SETS NUMBERS FOR FUNCS.
19200 DO 313 K=M,I-1
19300 313 IF(V(K).LT.85.)V(K)=V(K)+85.
19400 GO TO 4773
19500
22100 END